VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Cafe3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
'Project Name:  Array
'Host Name:     Array.CafePunchlist
'Date:          2009-06-01
'Version:
'Author:        Joseph Weir
'
' Array process for Punchlist.  To add other databases.
'

Option Explicit

' Current record of TD MPS
Private m_intRecordCurrent As Integer
' TD MPS shipments
Private m_colPackages As Collection
' Next TD MPS
Private WithEvents timerTDMPS As Timer
Attribute timerTDMPS.VB_VarHelpID = -1
' Auto process from Hold
Private WithEvents timerProcess As Timer
Attribute timerProcess.VB_VarHelpID = -1
' Give a break when process
Private WithEvents timerAfterShipment As Timer
Attribute timerAfterShipment.VB_VarHelpID = -1
' Tracking number for after shipment
Private m_colTracking As Collection
' Auto process from hold
Private m_strGUID As String
' TD MPS process helper
Dim m_objFCIL_TD As FedExCanada.TD
' Auto process
Dim m_objShipment As Shipment
' Auto process
Dim m_strTrackingNumber As String
'

 
  
'---------------------------------------------------------------------------------------
' Procedure : Cafe_AfterShipment
' DateTime  : 6/3/2009
' Purpose   : Raises after a successful shipment
'---------------------------------------------------------------------------------------
'
Private Sub Cafe_AfterShipment(ByVal ShipmentNumber As String, ByVal IsInternational As Boolean)
 
    On Error GoTo Cafe_AfterShipment_Error
  
    If g_formEntryBox Is Nothing Then Exit Sub
    
    ' Logfile "Cafe_AfterShipment", ShipmentNumber
    
    ' If multiple records were found and process individually was selected,
    ' execute next record.
    If m_colPackages Is Nothing Then
        Call AfterShipExport(m_colTracking)
        Set m_colTracking = Nothing
        Call Integration.ShowEntryBox
    Else
        If timerTDMPS Is Nothing Then Set timerTDMPS = New Timer
        timerTDMPS.Interval = 500 ' 2500
        timerTDMPS.Enabled = True
    End If
    Exit Sub
    
Cafe_AfterShipment_Error:
    MsgBox Err.Description & " (Array.CafePunchlist.Cafe_AfterShipment)", vbSystemModal
End Sub


'---------------------------------------------------------------------------------------
' Procedure : SetRecord
' DateTime  : 6/3/2009
' Purpose   : Calls RecordImport procedure and set package object on record return
'---------------------------------------------------------------------------------------
'
Public Function SetRecord(FieldValue As String, Optional strDateCreated As String) As Boolean
 
    On Error GoTo SetRecord_Error
    
    Dim i As Long
    Dim intRecordCount As Integer
    Dim vbResult As VbMsgBoxResult
    Dim objRecords As Collection
    
  ' logfile "SetRecord", FieldValue
 
    ' Retrieve record(s)
    Set objRecords = ODBC2.RecordImport(FieldValue)
 
    ' Set Record Count
    intRecordCount = objRecords.Item(1).RecordCount
    If objRecords.Count > 1 Then
        If objRecords.Item("BoxInfoPerOrder").RecordCount > 1 Then
            intRecordCount = intRecordCount * objRecords.Item("BoxInfoPerOrder").RecordCount
        End If
    End If
    
    ' Validate record count
    Select Case intRecordCount
        Case Is <= 0    ' No Records
            SetRecord = False
            GoTo Release
        Case 1      ' Single record found
            Set m_objShipment = New FSM.Shipment
            If Windows.ComputerName = "CAN-00325000" Then
                Call ODBC2.SetPackageValuesTest(objRecords, m_objShipment.Package, FieldValue)
            Else
                Call ODBC2.SetPackageValues(objRecords, m_objShipment.Package, FieldValue)
            End If
        Case Else       'Multiple records found
            If g_formEntryBox.checkTD.Value And ODBC2.m_strRecipientCountry = "US" Then
                Set m_colPackages = New Collection
                Call ODBC2.SetTDMPSValues(objRecords, m_colPackages, FieldValue)
            Else
                Set m_objShipment = New FSM.Shipment
                Call ODBC2.SetShipmentValues(objRecords, m_objShipment, FieldValue)
            End If
    End Select
    
    ' Single or intl MPS
    If Not m_objShipment Is Nothing Then
        If g_formEntryBox.checkProcess.Value Then
            If timerProcess Is Nothing Then Set timerProcess = New Timer
            timerProcess.Interval = 1000
            timerProcess.Enabled = True
        Else
            If m_objShipment.MPS.Packages.Count > 1 Then
                Call m_objShipment.MPS.SendToScreen(fsmMain)
            Else
                Call m_objShipment.Package.SendToScreen(fsmMain)
            End If
            DoEvents
            Screen.SetCursor 21, fsmMain
            Set m_objShipment = Nothing
        End If
    End If
    
    ' TD MPS
    If Not m_colPackages Is Nothing Then
        
        ' 2009-07-21, JFW
        modLabel8.m_boolTDMPSToggle = False
        modLabel8.m_lngTDMPSPieceCount = 1
        modLabel8.m_lngTDMPSTotalCount = m_colPackages.Count
        
        If g_formEntryBox.checkProcess.Value Then
            m_intRecordCurrent = 0
            If timerTDMPS Is Nothing Then Set timerTDMPS = New Timer
            timerTDMPS.Interval = 500 ' 2500
            timerTDMPS.Enabled = True
        Else
            m_intRecordCurrent = 1
            Set m_objShipment = m_colPackages.Item(1)
            Call m_objShipment.Package.SendToScreen(fsmMain)
            Set m_objShipment = Nothing
        End If
    
    Else
        ' 2009-07-21, JFW
        modLabel8.m_boolTDMPSToggle = False
        modLabel8.m_lngTDMPSPieceCount = 0
        modLabel8.m_lngTDMPSTotalCount = 0
    
    End If
    
    SetRecord = True
 
Release:
    Set objRecords = Nothing
 
    Exit Function
 
SetRecord_Error:
 
    MsgBox Err.Description & " (Array.CafePunchlist.SetRecord)", vbSystemModal
 
    Resume Release
    If False Then
        Resume
    End If
    
End Function
 
Private Sub Cafe_AfterShipPackage(ByVal TrackingNumber As String, ByVal Meter As String, ByVal IsInternational As Boolean)

    If g_formEntryBox Is Nothing Then Exit Sub

    ' Logfile "Cafe_AfterShipPackage", TrackingNumber

    If m_colTracking Is Nothing Then Set m_colTracking = New Collection
    m_colTracking.Add TrackingNumber
    
End Sub

'---------------------------------------------------------------------------------------
' Procedure : Cafe_ClearFields
' DateTime  : 6/3/2009
' Purpose   : Raises on the button click of clear fields
'---------------------------------------------------------------------------------------
'
Private Sub Cafe_ClearFields()
 
    On Error GoTo Cafe_ClearFields_Error
 
    If g_formEntryBox Is Nothing Then Exit Sub
 
  ' logfile "Cafe_ClearFields"
    
    m_strGUID = ""
    Set m_objShipment = Nothing
    Set m_colPackages = Nothing
    Set m_colTracking = Nothing
    
    Call Integration.ShowEntryBox
 
    ' Clear TD MPS label
    modLabel8.m_boolTDMPSToggle = False
    modLabel8.m_lngTDMPSPieceCount = 0
    modLabel8.m_lngTDMPSTotalCount = 0

    Exit Sub
 
Cafe_ClearFields_Error:
 
    MsgBox Err.Description & " (Array.CafePunchlist.Cafe_ClearFields)", vbSystemModal
 
End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : AfterShipExport
' DateTime  : 6/3/2009
' Purpose   : Pull data to export
'---------------------------------------------------------------------------------------
'
Private Sub AfterShipExport(ByVal colNumber As Collection)
 
    On Error GoTo AfterShipExport_Error
 
    Dim objTable As FSM.Table
    Dim strFieldList As String
    Dim blnReturn As Boolean
    Dim Number As Variant
    
    ' Logfile "AfterShipExport", "Count " & colNumber.Count
    
    For Each Number In colNumber
       ' Set return string request
       strFieldList = "2382,29,37,1274,25,24"
    
       ' Retrieve shipment value from FSM
       Set objTable = Cafe3.Databases.ExecDirect("Select " & strFieldList & " From Shipment Where 29 = '" & Number & "'")
       If objTable.Records.Count = 0 Then
           Set objTable = Cafe3.Databases.ExecDirect("Select " & strFieldList & " From Shipment Where 2044 = '" & Number & "'")
           blnReturn = True
       End If
    
       If objTable.Records.Count > 0 Then
           If objTable.Records(0).Fields(0).Value = "0" Then
               Call ODBC3.RecordExport(objTable, colNumber.Item(1))
           End If      'Send shipment values to external source
       End If
    Next Number
    
Release:
    ' Release object
    Set objTable = Nothing
 
    Exit Sub
 
AfterShipExport_Error:
 
    MsgBox Err.Description & " (Array.CafePunchlist.AfterShipExport)", vbSystemModal
    Resume Release
     
End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : Cafe_DeletePackage
' DateTime  : 6/3/2009
' Purpose   : Raises after a delete package
'---------------------------------------------------------------------------------------
'
Private Sub Cafe_DeletePackage(ByVal TrackingNumber As String, ByVal Meter As String, ByVal IsInternational As Boolean)
 
    On Error GoTo Cafe_DeletePackage_Error
    
    If g_formEntryBox Is Nothing Then Exit Sub
    
    Call ODBC3.RecordExportDeleteShipment(TrackingNumber, "25")

    Exit Sub
 
Cafe_DeletePackage_Error:
 
    MsgBox Err.Description & " (Array.CafePunchlist.Cafe_DeletePackage)", vbSystemModal
 
End Sub


Private Sub Cafe_SystemKeyPress(ByVal KeyName As String)

    On Error Resume Next
    
    Dim i As Long
    
    Select Case KeyName
        Case Is = "Cntrl+F3"
        
            Unload g_formCotyBatch
            Set g_formCotyBatch = Nothing
            Unload g_formArrayBatch
            Set g_formArrayBatch = Nothing
        
            If Not g_formEntryBox Is Nothing Then
                Unload g_formEntryBox
                Set g_formEntryBox = Nothing
            End If
            Set g_formEntryBox = New frmEntryBox
            Call Integration.ShowEntryBox
    End Select
    
End Sub

Private Sub timerAfterShipment_Execute()
    
    ' Given one tracking number, dom or intl
    
    Dim i As Long
    Dim objTable As Table
    
    timerAfterShipment.Enabled = False
    ' Logfile "timerAfterShipment_Execute", m_strTrackingNumber
    
    If m_strTrackingNumber <> "" Then
        Set objTable = Cafe3.Databases.ExecDirect("select 1123 from Shipment where 29 = '" & m_strTrackingNumber & "'")
        If Not objTable Is Nothing Then
            If objTable.Records.Count > 0 Then
                m_strTrackingNumber = objTable.Records(0).Fields(0).Value
                Set objTable = Cafe3.Databases.ExecDirect("select 29 from Shipment where 1123 = '" & m_strTrackingNumber & "'")
                If Not objTable Is Nothing Then
                    Set m_colTracking = New Collection
                    For i = 0 To objTable.Records.Count - 1
                        m_colTracking.Add objTable.Records(i).Fields(0).Value
                    Next i
                    ' Logfile "Cafe3.timerAfterShipment, tracking number " & m_strTrackingNumber & ", Calling Cafe3.Cafe_AfterShipment"
                    Call Cafe_AfterShipment("", True)
                End If
            End If
        End If
    End If
    
    m_strTrackingNumber = ""
    
End Sub

Private Sub timerProcess_Execute()

    On Error GoTo ErrorExit
    Dim i As Long, j As Long
    Dim strTransIn As String
    Dim strTransOut As String
    Dim strTrackingNumber As String
    Dim strError As String
    
    ' Logfile "timerProcess_Execute"
    
    timerProcess.Enabled = False
    ' We are set to auto process
    If g_formEntryBox.checkProcess Then
        ' An auto process is underway
        If Not m_objShipment Is Nothing Then
            
            ' TD, single pieces only
            If g_formEntryBox.checkTD _
            And m_objShipment.MPS.Packages.Count <= 1 _
            And m_objShipment.Recipient.Country = "US" Then
                
                ' Logfile "timerProcess_Execute", "TD via FCIL"
                
                If m_objFCIL_TD Is Nothing Then
                    Set m_objFCIL_TD = New FedExCanada.TD
                End If
                ' True, we're here because TD MPS
                If True Then
                    If m_objFCIL_TD.UseCurrentMaster <> "" Then
                        ' 2011-01-31, JFW, Get CI flag from master.
                        m_objShipment.Package.Intl.IncludeCommercialInvoice = m_objFCIL_TD.MasterShipmentCI
                        m_objShipment.Package.SpecialServices.FutureShipment.ShipDate = m_objFCIL_TD.MasterShipmentPickupDate
                        ' Return address
                        With m_objFCIL_TD.MasterShipmentReturnAddress
                            m_objShipment.Package.ReturnAddress.Address1 = .Item("Address1").Item("Value")
                            m_objShipment.Package.ReturnAddress.Address2 = .Item("Address2").Item("Value")
                            m_objShipment.Package.ReturnAddress.City = .Item("City").Item("Value")
                            m_objShipment.Package.ReturnAddress.Company = .Item("Company").Item("Value")
                            m_objShipment.Package.ReturnAddress.Contact = .Item("Contact").Item("Value")
                            m_objShipment.Package.ReturnAddress.Phone = .Item("Phone").Item("Value")
                            m_objShipment.Package.ReturnAddress.State = .Item("State").Item("Value")
                            m_objShipment.Package.ReturnAddress.Zip = .Item("Zip").Item("Value")
                        End With
                        
                        ' Logfile "Cafe3.Process, b4 process, TD, Intl TD Process"
        
                        strError = ""
                        strTrackingNumber = ""
                        On Error Resume Next
                        Err.Clear
                        m_objShipment.Package.Process
                        strTrackingNumber = ""
                        If Err.Number <> 0 Then
                            strError = Err.Source & ", " & Err.Description
                        End If
                        DoEvents
                        If strError <> "" Then
                            ' Logfile "Cafe3.Process, error, " & strError
                            ' 2011-08-11, JFW, Possible ETD upload error.
                            If 0 <> InStr(1, LCase(strError), "upload") Then
                                MsgBox "Error on process.  ETD upload failed.  Print CI or cancel and reship.  " & strError, vbApplicationModal + vbSystemModal
                            Else
                                MsgBox "Error on process. " & strError, vbApplicationModal + vbSystemModal
                            End If
                        ElseIf m_objShipment.Package.TrackNo <> "" Then
                            strTrackingNumber = m_objShipment.Package.TrackNo
                            ' Logfile "Cafe3.Process, process, tracking number " & strTrackingNumber
                            ' Logfile "Cafe3.Process, calling Cafe1.AfterShipment"
                            Call Cafe1.AfterShipment(strTrackingNumber)
                            ' Logfile "Cafe3.Process, calling Cafe_AfterShipPackage"
                            Call Cafe_AfterShipPackage(strTrackingNumber, "", True)
                            If m_colPackages Is Nothing Then
                                ' TD single piece
                                Call Cafe_AfterShipment("", True)
                            Else
                                If timerTDMPS Is Nothing Then Set timerTDMPS = New Timer
                                timerTDMPS.Interval = 500 ' 2500
                                timerTDMPS.Enabled = True
                            End If
                            
                        Else
                            Err.Raise 12345, "Cafe3.Process", "indeterminate transaction output.  No tracking number and no error message.  " _
                                & strTransOut
                        End If
                    Else
                        Err.Raise 12345, "Cafe3.Process", "Current TD Master shipment cannot be determined.  See the TD Dashboard."
                    End If
                End If
                                    
            Else ' non-TD Process
                If m_objShipment.MPS.Packages.Count > 0 Then
                
                    ' Logfile "timerProcess_Execute", "MPS Process"
                
                    strError = ""
                    strTrackingNumber = ""
                    On Error Resume Next
                    Err.Clear
                    m_objShipment.MPS.Process
                    If Err.Number <> 0 Then
                        strError = Err.Source & ", " & Err.Description
                    End If
                    DoEvents
                    If strError = "" Then
                        m_strTrackingNumber = m_objShipment.MPS.Packages(0).TrackingNumber
                        If Err.Number <> 0 Then
                            strError = Err.Source & ", " & Err.Description
                        End If
                    End If
                    If strError <> "" Then
                        ' Logfile "Cafe3.Process, error, " & strError
                        ' 2011-08-11, JFW, Possible ETD upload error.
                        If 0 <> InStr(1, LCase(strError), "upload") Then
                            MsgBox "Error on process.  ETD upload failed.  Print CI or cancel and reship.  " & strError, vbApplicationModal + vbSystemModal
                        Else
                            MsgBox "Error on process. " & strError, vbApplicationModal + vbSystemModal
                        End If
                    ElseIf m_strTrackingNumber <> "" Then
                        ' Logfile "Cafe3.Process, MPS Process, tracking number " & m_strTrackingNumber
                        Call Cafe1.AfterShipment(m_strTrackingNumber)
                    Else
                        MsgBox "Error on process.  No error message and no tracking number.", vbApplicationModal + vbSystemModal
                    End If
                    
                Else
                    
                    ' Logfile "timerProcess_Execute", "Package Process"
                    
                    strError = ""
                    strTrackingNumber = ""
                    On Error Resume Next
                    Err.Clear
                    m_objShipment.Package.Process
                    If Err.Number <> 0 Then
                        strError = Err.Source & ", " & Err.Description
                    End If
                    DoEvents
                    If strError = "" Then
                        m_strTrackingNumber = m_objShipment.Package.TrackNo
                        If Err.Number <> 0 Then
                            strError = Err.Source & ", " & Err.Description
                        End If
                    End If
                    If strError <> "" Then
                        ' Logfile "Cafe3.Process, error, " & strError
                        ' 2011-08-11, JFW, Possible ETD upload error.
                        If 0 <> InStr(1, LCase(strError), "upload") Then
                            MsgBox "Error on process.  ETD upload failed.  Print CI or cancel and reship.  " & strError, vbApplicationModal + vbSystemModal
                        Else
                            MsgBox "Error on process. " & strError, vbApplicationModal + vbSystemModal
                        End If
                    ElseIf m_strTrackingNumber <> "" Then
                        ' Logfile "Cafe3.Process, Package, tracking number " & m_strTrackingNumber
                        ' Logfile "Cafe3.Process, Package, calling Cafe1.AfterShipment"
                        Call Cafe1.AfterShipment(m_strTrackingNumber)
                    Else
                        MsgBox "Error on process.  No error message and no tracking number.", vbApplicationModal + vbSystemModal
                    End If
                
                End If
                If timerAfterShipment Is Nothing Then Set timerAfterShipment = New Timer
                timerAfterShipment.Interval = 200 ' 1000
                timerAfterShipment.Enabled = True
                
            End If
        End If
    End If
    Exit Sub

ErrorExit:
    MsgBox "Error at Array.CafePunchlist.Process.Execute, " & Err.Source & ", " & Err.Description
    m_strGUID = ""
    If False Then
        Resume
    End If
End Sub

Private Sub timerTDMPS_Execute()

    On Error GoTo ErrorExit
    Dim i As Long
 
    timerTDMPS.Enabled = False
    
    m_intRecordCurrent = m_intRecordCurrent + 1
    
    ' Logfile "Cafe3.TDMPS_Execute, count " & m_intRecordCurrent
    
    If m_intRecordCurrent > m_colPackages.Count Then
        Set m_colPackages = Nothing
        Call Cafe_AfterShipment("", True)
        Call Integration.ShowEntryBox
        Exit Sub
    End If
 
    ' Instantiate Shipment Object
    Set m_objShipment = m_colPackages.Item(m_intRecordCurrent)
    
    ' TD Piece commodity
    If m_intRecordCurrent > 1 Then
        m_objShipment.Package.Intl.Commodities.Clear
        With m_objShipment.Package.Intl.Commodities.Add("1")
            .CountryOfMfg = "CA"
            .Description = "Package " & m_intRecordCurrent & " of " & CStr(m_colPackages.Count) _
                        & ", master tracking number " & "000000000000"
            If Not m_colTracking Is Nothing Then
                If m_colTracking.Count >= 1 Then
                    .Description = "Package " & m_intRecordCurrent & " of " & CStr(m_colPackages.Count) _
                        & ", master tracking number " & m_colTracking.Item(1)
                End If
            End If
            .UnitOfMeasure = "EA"
            .UnitQuantity = 1
            .UnitValue = 0.000001
        End With
    End If
    
    ' 2009-07-21, JFW
    modLabel8.m_boolTDMPSToggle = False
    modLabel8.m_lngTDMPSPieceCount = m_intRecordCurrent
    modLabel8.m_lngTDMPSTotalCount = m_colPackages.Count
    
    'Set screen with package object
    If g_formEntryBox.checkProcess.Value Then
        ' Via hold
        ' m_strGUID = objShipment.SendToHold
        If timerProcess Is Nothing Then Set timerProcess = New Timer
        timerProcess.Interval = 200 ' 1000
        timerProcess.Enabled = True
    Else
        m_strGUID = ""
        Call m_objShipment.Package.SendToScreen(fsmMain)
        DoEvents
        Set m_objShipment = Nothing
    End If
    
Release:
    Exit Sub
 
ErrorExit:
    MsgBox Err.Description & " (Array.CafePunchlist.TDMPS.Execute)", vbSystemModal
    Resume Release
    Resume
End Sub
